home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt40s2.arc / LEARNACH.MOD < prev    next >
Text File  |  1987-07-27  |  4KB  |  109 lines
  1. (*----------------------------------------------------------------------*)
  2. (*        Learn_A_Character --- Learn character for script              *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Learn_A_Character( Ch : CHAR );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*       Procedure:   Learn_A_Character                                 *)
  10. (*                                                                      *)
  11. (*       Purpose:     Learn character for script in learn mode          *)
  12. (*                                                                      *)
  13. (*       Calling Sequence:                                              *)
  14. (*                                                                      *)
  15. (*          Learn_A_Character( Ch: CHAR );                              *)
  16. (*                                                                      *)
  17. (*             Ch --- Character to be learned                           *)
  18. (*                                                                      *)
  19. (*----------------------------------------------------------------------*)
  20.  
  21. VAR
  22.    L: INTEGER;
  23.    I: INTEGER;
  24.    J: INTEGER;
  25.    K: INTEGER;
  26.  
  27. BEGIN (* Learn_A_Character *)
  28.                                    (* Output stuff from remote system *)
  29.  
  30.    IF ( ORD( Script_String_2[0] ) <> 0 ) THEN
  31.  
  32.                                    (* Any waitstring after first in sequence *)
  33.                                    (* is spurious so don't generate it.      *)
  34.  
  35.       IF ( NOT Script_Wait_Generated ) THEN
  36.          BEGIN
  37.  
  38.             L := ORD( Script_String_2[0] );
  39.             J := L;
  40.             K := 0;
  41.                                    (* If last chars are CR+LF, back up    *)
  42.                                    (* in front of them.                   *)
  43.             IF ( L > 1 ) THEN
  44.                IF ( ( Script_String_2[L]   = CHR( LF ) ) AND
  45.                     ( Script_String_2[L-1] = CHR( CR ) ) ) THEN
  46.                   BEGIN
  47.                      L := L - 2;
  48.                      J := L;
  49.                   END;
  50.                                    (* Loop until required number of lines *)
  51.                                    (* picked up.                          *)
  52.             REPEAT
  53.  
  54.                I := J;
  55.                L := J;
  56.                                    (* Scan for CR and LFs *)
  57.  
  58.                WHILE ( ( I > 1 ) AND ( NOT ( Script_String_2[I] IN [^M,^J] ) ) ) DO
  59.                   I := PRED( I );
  60.                                    (* Adjust text pointer for next line *)
  61.  
  62.                IF ( Script_String_2[I] = CHR( LF ) ) THEN
  63.                   IF ( Script_String_2[I-1] = CHR( CR ) ) THEN
  64.                      J := I - 2
  65.                   ELSE
  66.                      J := PRED( I )
  67.                ELSE
  68.                   J := PRED( I );
  69.                                    (* Point after CR or LF *)
  70.  
  71.                IF ( Script_String_2[I] IN [^M,^J] ) THEN
  72.                   I := SUCC( I );
  73.  
  74.                                    (* Generate waitstring if we got something *)
  75.  
  76.                IF ( I > 0 ) THEN
  77.                   IF ( ( L - I + 1 ) > 0 ) THEN
  78.                      BEGIN
  79.                         WRITELN( Script_File , 'WaitString "',
  80.                                  Write_Ctrls( SUBSTR( Script_String_2, I, L - I + 1 ) ), '"' );
  81.                         K := SUCC( K );
  82.                      END;
  83.  
  84.             UNTIL ( ( K >= Script_Learn_Lines ) OR ( I <= 1 ) );
  85.  
  86.                                    (* Indicate a waitstring has been generated *)
  87.  
  88.             Script_Wait_Generated := TRUE;
  89.  
  90.          END;
  91.  
  92.    Script_String_2[0] := #0;
  93.                                    (* If CR, end of user input, generate SText *)
  94.    IF( ORD( Ch ) = CR ) THEN
  95.       BEGIN
  96.          WRITELN( Script_File , 'SText "', Script_String, '|"' );
  97.          Script_String[0]      := #0;
  98.          Script_Wait_Generated := FALSE;
  99.       END
  100.    ELSE
  101.       IF ( ORD( Script_String[0] ) = 240 ) THEN
  102.          BEGIN
  103.             MOVE( Script_String[2], Script_String[1], 239 );
  104.             Script_String[240] := Ch;
  105.          END
  106.       ELSE
  107.          Script_String := Script_String + Ch;
  108.  
  109. END   (* Learn_A_Character *);